home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol006 / gl1.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  6.3 KB  |  192 lines
  1. 10 ' PROGRAM NAME "GL1"
  2. 490 CLEAR 1500
  3. 510 DIM D1$(16)
  4. 520 DIM D$(16)
  5. 530 DIM B$(100)  ' MATRIX FOR TRANSACTIONS
  6. 535 DIM II(16)
  7. 540 R$="R":F=1:D=1:BK$=" ":ZER$=" "
  8. 550 GL$="LEDGER"
  9. 560 PRINT "ENTER GENERAL LEDGER TRANSACTIONS"
  10. 570 PRINT
  11. 610 PRINT "ENTER -1- FOR HEADERS & BAL FWDS"
  12. 620 PRINT "ENTER -2- FOR CHECK TRANSACTIONS"
  13. 630 PRINT "ENTER -3- FOR VOUCHER TRANSACTIONS"
  14. 640 INPUT TY$
  15. 690 INPUT "ENTER -U- FOR UNBALANCED ENTRIES";U$
  16. 700 IF TY$="3" THEN TY$="2":T$="V":GOTO 730
  17. 710 IF TY$="2" THEN T$="C":GOTO 730
  18. 720 IF TY$="1" THEN 730 ELSE 690
  19. 730 INPUT "ENTER TRANSACTION MO & YR AS - MOYR";GD$
  20. 740 PRINT "100 ENTRIES MAX PER CHECK OR VOUCHER"
  21. 750 PRINT "ENTER -T- TO TOTAL TRANSACTIONS"
  22. 760 PRINT "ENTER -L- FOR LAST TRANSACTION" ' ALL TRANSACTIONS ENTERED
  23. 770 OPEN R$,F,GL$
  24. 780 A=2037           ' GET TABLE TO DETERMINE FILE START
  25. 790 GET #1,A
  26. 800 FOR II=1 TO 16    ' SEARCH(TABLE FOR CORRECT MONTH & YEAR
  27. 810 FIELD #1, ((II-1)*8) AS D$, 8 AS D1$(II)
  28. 820 IF GD$=MID$(D1$(II),1,4) THEN 860  ' THIS IS CORRECT MONTH & YEAR
  29. 830 NEXT II
  30. 840 PRINT "NO FILE ADDRESS IN TABLE"
  31. 850 GOTO 850
  32. 860 REC$=MID$(D1$(II),5,4)  ' LOAD FILE ADDRESS FROM TABLE
  33. 870 REC=VAL(REC$)
  34. 880 GET #1,REC              ' GET FIRST RECORD
  35. 890 IF TY$="1" THEN 1970    ' IS IT A BALANCE FORWARD RECORD
  36. 900 '
  37. 910 ' ****** SET UP TERMINAL HEADINGS FOR TERMINAL INPUT ******
  38. 920 '
  39. 930 T#=0                  ' COUNTER FOR DEBITS & CREDITS
  40. 940 H1$="   TRANS ACCT C/V                      AMOUNT"
  41. 950 H2$="  MODYYR NUMB NUMB DESCRIPTION....-$$$.$$$.$$"
  42. 960 S1=0                  ' RE-SET ERROR SWITCH
  43. 970 I=1
  44. 980 FOR I=1 TO 100'   FILE ENTRIES - 100 - MAX
  45. 990 PRINT H1$
  46. 1000 PRINT H2$
  47. 1010 INPUT A$        ' DATA INPUT LINE
  48. 1020 '
  49. 1030 '****** EDIT DATA ENTERED FOR ERRORS ******
  50. 1040 '
  51. 1050 IF MID$(A$,1,1)="T" THEN 1300 ' TO TOTAL CHECK OR VOUCHER
  52. 1060 IF MID$(A$,1,1)="L" THEN 1300 ' LAST ENTRY MADE
  53. 1070 IF MID$(A$,(LEN(A$)))="/" THEN 990
  54. 1080 IF MID$(A$,1,2)<"01" OR MID$(A$,1,2)>"13" THEN 1800
  55. 1090 IF MID$(A$,3,2)<"01" OR MID$(A$,3,2)>"31" THEN 1800
  56. 1100 IF MID$(A$,5,2)<"76" THEN 1800
  57. 1110 IF MID$(A$,7,1)>="1" THEN 1800
  58. 1120 IF MID$(A$,12,1)>="1" THEN 1800
  59. 1130 IF TY$="1" THEN 2030
  60. 1140 IF MID$(A$,17,1)>="1" THEN 1800
  61. 1150 IF MID$(A$,33,1)="-" THEN 1180
  62. 1160 IF MID$(A$,33,1)<"1" THEN 1180
  63. 1170 GOTO 1800
  64. 1180 IF MID$(A$,37,1)="." THEN 1210
  65. 1190 IF MID$(A$,37,1)<"1" THEN 1210
  66. 1200 GOTO 1800
  67. 1210 IF MID$(A$,41,1)<>"." THEN 1800
  68. 1220 '
  69. 1230 '****** CHECK FOR HIGHEST POSSIBLE ACCOUNT NUMBER ******
  70. 1240 '
  71. 1250 IF MID$(A$,8,4)>"7904" OR MID$(A$,8,4)<"1000" THEN 1800
  72. 1260 '
  73. 1270 IF LEN(A$)<>43 THEN 1800
  74. 1280 L=L+1
  75. 1290 LPRINT A$;SPC(5) USING "##";L  ' PRINT OUT LINE NUMBER
  76. 1300 IF A$="T" OR A$="L" THEN 1910
  77. 1310 IF TY$="1" THEN 2190
  78. 1320 '
  79. 1330 '****** LOAD MATRIX - CHECK AND VOUCHERS ******
  80. 1340 '
  81. 1350 B$(I)=MID$(A$,1,6)+MID$(A$,8,4)+T$+MID$(A$,13,4)
  82. 1360 B$(I)=B$(I)+MID$(A$,18,16)+ZER$+MID$(A$,34,3)
  83. 1370 B$(I)=B$(I)+MID$(A$,38,3)+MID$(A$,41,3)+TY$
  84. 1380 C$=MID$(A$,33,4)+MID$(A$,38,3)+MID$(A$,41,3)
  85. 1390 TT#=VAL(C$)
  86. 1400 T#=T#+TT#
  87. 1410 IF S1=1 THEN 1450    ' CHECK ERROR SWITCH
  88. 1420 NEXT I
  89. 1430 PRINT "ERROR TO MANY TRANSACTIONS";CHR$(7);CHR$(7);CHR$(7);CHR$(7)
  90. 1440 GOTO 490
  91. 1450 PRINT SPC(32) USING "$#,###,###.##-";T# ' PRINT OUT TOTAL DEBITS & 
  92. 1460 LPRINT SPC(30) USING "$#,###,###.##-";T#
  93. 1470 LPRINT
  94. 1480 L=0
  95. 1490 IF U$="U" THEN T#=0:GOTO 1660
  96. 1500 IF T#<.01# AND T#>-.01# THEN 1660' DR = CR GO TO PUT DISK
  97. 1510 '
  98. 1520 '****** OPTIONAL LINE CORRECTION ROUTINE ******
  99. 1530 '****** LINE PRINTER NECESSARY                 ******
  100. 1540 '
  101. 1550 PRINT "TO RE-START, GOTO RUN"
  102. 1560 INPUT "*** ERROR *** DR<>CR-ENTER ERROR LINE #";LN
  103. 1570 I=LN
  104. 1580 S1=1                 ' TURN ERROR SWITCH ON
  105. 1590 E$=MID$(B$(I),31,11)
  106. 1600 TT#=VAL(E$)
  107. 1610 T#=T#-TT#
  108. 1620 GOTO 1010
  109. 1630 '
  110. 1640 '****** PROCESS AND WRITE OUT THIS TRANSACTION ******
  111. 1650 '
  112. 1660 FOR I=1 TO 100
  113. 1670 T#=0
  114. 1680 IF B$(I)="T" THEN 890'  END OF THIS TRANSACTION
  115. 1690 GOSUB 2270
  116. 1700 NEXT I
  117. 1710 GOTO 1430
  118. 1720 LSW=1                ' TURN LAST RECORD SWITCH ON
  119. 1730 GOSUB 2270           ' GO PROCESS LAST RECORD
  120. 1740 CLOSE 1              ' CLOSE LEDGER FILE
  121. 1750 PRINT "EOJ"          ' PRINT END OF JOB MESSAGE
  122. 1760 LOAD "GLMENU",0,R
  123. 1770 '
  124. 1780 ' ****** DATA ENTRY ERROR - RE-ENTER DATA ******
  125. 1790 '
  126. 1800 PRINT CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7)
  127. 1810 A$=ZZ$               ' CLEAR INPUT AREA TO BLANKS
  128. 1820 GOTO 990
  129. 1830 '
  130. 1840 '
  131. 1850 CLOSE 1
  132. 1860 UNLOAD 1
  133. 1870 PRINT "END OF DISK ERROR. THIS SHOULD NEVER OCCUR USING THIS"
  134. 1880 PRINT "PROGRAM.  GL2 CHECKS TO MAKE SURE THERE IS ALWAYS ROOM"
  135. 1890 PRINT "FOR A ENTIRE MONTHS FILE."
  136. 1900 STOP
  137. 1910 IF A$="L" THEN 1720'  LAST TRANSACTIONS TO PROCESS
  138. 1920 B$(I)=A$
  139. 1930 GOTO 1450
  140. 1940 '
  141. 1950 '****** SET UP TERMINAL LINE FOR ACCOUNT HEADER ******
  142. 1960 '
  143. 1970   H1$="   TRANS ACCT                          AMOUNT "
  144. 1980   H2$="  MODYYR NUMB ACCOUNT HEADER......-$.$$$.$$$.$$"
  145. 1990 GOTO 960
  146. 2000 '
  147. 2010 '****** EDIT BALANCE FORWARD - ACCOUNT HEADER ENTRIES ******
  148. 2020 '
  149. 2030 IF MID$(A$,33,1)="-" THEN 2060
  150. 2040 IF MID$(A$,33,1)<"1" THEN 2060
  151. 2050 GOTO 1800
  152. 2060 IF MID$(A$,35,1)="." THEN 2090
  153. 2070 IF MID$(A$,35,1)<"1" THEN 2090
  154. 2080 GOTO 1800
  155. 2090 IF MID$(A$,39,1)="." THEN 2120
  156. 2100 IF MID$(A$,39,1)<"1" THEN 2120
  157. 2110 GOTO 1800
  158. 2120 IF MID$(A$,43,1)<>"." THEN 1800
  159. 2130 IF MID$(A$,8,4)>"7904" OR MID$(A$,8,4)<"1000" THEN 1800
  160. 2140 IF LEN(A$)<>45 THEN 1800
  161. 2150 GOTO 1280
  162. 2160 '
  163. 2170 '****** LOAD MATRIX - BALANCE FORWARD-ACCOUNT HEADERS ******
  164. 2180 '
  165. 2190 B$(I)=MID$(A$,1,6)+MID$(A$,8,4)+MID$(A$,13,20)
  166. 2200 B$(I)=B$(I)+MID$(A$,33,2)+MID$(A$,36,3)+MID$(A$,40,6)
  167. 2210 B$(I)=B$(I)+TY$
  168. 2220 C$=(MID$(A$,33,2))+(MID$(A$,36,3))+(MID$(A$,40,6))
  169. 2230 GOTO 1390
  170. 2240 '
  171. 2250 '****** LOAD DISK OUTPUT AREA ******
  172. 2260 '
  173. 2270 FOR M=1 TO 3
  174. 2280 FIELD #1, (M-1)*42 AS D$,42 AS D1$(M)
  175. 2330 IF WSW=1 AND MID$(B$(I),1,2)<>MID$(D1$(M),1,2) THEN 2410
  176. 2340 IF MID$(D1$(M),1,3)="EOF" THEN 2410 
  177. 2350 IF MID$(D1$(M),1,3)<"001" THEN 2410 
  178. 2360 NEXT M
  179. 2370 REC=REC+1              
  180. 2380 IF REC=2027 THEN 1850  
  181. 2390 GET #1,REC             
  182. 2400 GOTO 2270
  183. 2410 IF LSW=1 THEN 2460  
  184. 2420 WSW=1            
  185. 2430 RSET D1$(M)=MID$(B$(I),1,42)
  186. 2440 PUT #1,REC        
  187. 2450 RETURN
  188. 2460 LSET D1$(M)="EOF"  
  189. 2470 GOTO 2440
  190. 2480 END
  191. 
  192. 2430